Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

96

Games Picked

148

Number of predictions

75

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Chicago Bears Chicago Bears Yes 56 0.7467
2 Indianapolis Colts Indianapolis Colts Yes 56 0.7467
3 Baltimore Ravens Cleveland Browns No 4 0.0533
4 Pittsburgh Steelers Pittsburgh Steelers Yes 69 0.9200
5 Cincinnati Bengals Houston Texans No 7 0.0933
6 Minnesota Vikings Minnesota Vikings Yes 44 0.5867
7 San Francisco 49ers San Francisco 49ers Yes 40 0.5333
8 Tampa Bay Buccaneers Tampa Bay Buccaneers Yes 45 0.6000
9 Atlanta Falcons Arizona Cardinals No 11 0.1467
10 Detroit Lions Detroit Lions Yes 63 0.8400
11 Dallas Cowboys Dallas Cowboys Yes 73 0.9733
12 Seattle Seahawks Seattle Seahawks Yes 56 0.7467
13 Las Vegas Raiders Las Vegas Raiders Yes 38 0.5067
14 Buffalo Bills Denver Broncos No 7 0.0933

Individual Predictions

row

Individual Table

Individual Results
Week 10
Name Weekly # Correct Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10
Karen Coleman 7 10 NA 10 8 9 4 9 13 11 0.7857 9 0.6045 0.5440
Sarah Sweet 9 12 12 9 8 NA 6 11 11 10 0.7143 9 0.6617 0.5955
Vincent Scannelli 11 11 8 11 7 NA 5 9 12 10 0.7143 9 0.6316 0.5684
Terry Hardison 10 10 9 11 7 9 4 11 9 10 0.7143 10 0.6081 0.6081
John Plaster 8 12 8 10 NA NA 6 9 7 10 0.7143 8 0.5882 0.4706
Jonathon Leslein 9 9 9 9 7 11 5 9 8 10 0.7143 10 0.5811 0.5811
Keithon Corpening 8 NA NA NA NA NA NA 11 12 9 0.6429 4 0.6667 0.2667
William Schouviller 10 9 11 10 8 9 NA 13 10 9 0.6429 9 0.6593 0.5934
James Tierney 9 10 NA 10 10 12 7 10 8 9 0.6429 9 0.6343 0.5709
Jason Schattel 7 10 9 11 9 10 3 13 12 9 0.6429 10 0.6284 0.6284
Bradley Hobson 8 10 11 12 8 11 4 NA 8 9 0.6429 9 0.6136 0.5522
Cheryl Brown 10 12 11 9 6 9 6 10 8 9 0.6429 10 0.6081 0.6081
George Mancini 7 12 10 10 9 10 6 NA 7 9 0.6429 9 0.6061 0.5455
Cody Koerwitz 7 9 11 12 7 10 6 NA 9 9 0.6429 9 0.6061 0.5455
Paul Presti 9 10 12 9 8 9 5 8 NA 9 0.6429 9 0.5896 0.5306
Robert Gelo 6 9 10 10 9 11 5 11 6 9 0.6429 10 0.5811 0.5811
Daniel Baller 6 12 11 9 8 9 3 10 8 9 0.6429 10 0.5743 0.5743
Amy Asberry 8 9 10 9 9 8 5 10 6 9 0.6429 10 0.5608 0.5608
Brandon Parks 8 8 NA NA 9 9 5 9 9 9 0.6429 8 0.5593 0.4474
Alexander Santillan 5 NA 8 9 5 11 6 11 8 9 0.6429 9 0.5455 0.4910
Justin Crick 11 11 11 13 8 11 4 11 11 8 0.5714 10 0.6689 0.6689
George Sweet 9 11 10 12 7 10 10 NA 11 8 0.5714 9 0.6667 0.6000
Chris Papageorge 11 11 11 10 8 9 5 11 12 8 0.5714 10 0.6486 0.6486
Ryan Wiggins 8 11 11 12 7 11 5 11 10 8 0.5714 10 0.6351 0.6351
Gabriel Quinones 9 11 12 12 6 9 6 11 NA 8 0.5714 9 0.6269 0.5642
Ronald Schmidt 11 13 11 8 8 11 5 9 8 8 0.5714 10 0.6216 0.6216
Anthony Bloss 8 10 11 12 10 10 5 9 9 8 0.5714 10 0.6216 0.6216
Aubrey Conn 9 12 8 11 9 9 4 11 11 8 0.5714 10 0.6216 0.6216
Montee Brown 7 NA NA 9 9 11 6 12 11 8 0.5714 8 0.6186 0.4949
Ramar Williams NA 11 11 9 8 8 6 12 NA 8 0.5714 8 0.6186 0.4949
Michael Moss 10 NA 11 13 7 9 4 10 9 8 0.5714 9 0.6136 0.5522
Ryan Cvik 11 11 9 13 6 10 8 8 6 8 0.5714 10 0.6081 0.6081
Brian Hollmann 8 13 8 9 8 9 6 13 8 8 0.5714 10 0.6081 0.6081
Brian Patterson 10 10 8 11 7 11 5 10 10 8 0.5714 10 0.6081 0.6081
Matthew Schultz 8 NA 10 8 9 9 6 10 11 8 0.5714 9 0.5985 0.5387
Bunnaro Sun 9 10 9 8 9 9 6 9 11 8 0.5714 10 0.5946 0.5946
Paul Shim 10 9 10 11 7 9 4 10 10 8 0.5714 10 0.5946 0.5946
Kevin Kehoe 9 10 11 12 7 8 6 10 7 8 0.5714 10 0.5946 0.5946
Yiming Hu 9 10 8 12 7 9 6 9 10 8 0.5714 10 0.5946 0.5946
Shaun Dahl 8 8 10 10 7 9 5 13 9 8 0.5714 10 0.5878 0.5878
Earl Dixon 9 11 8 12 5 NA 7 8 9 8 0.5714 9 0.5789 0.5210
DAVID PLATE 8 NA 8 9 8 10 5 9 11 8 0.5714 9 0.5758 0.5182
Shawn Carden 9 12 6 9 8 9 5 10 9 8 0.5714 10 0.5743 0.5743
Steven Webster 8 8 6 8 9 8 6 10 10 8 0.5714 10 0.5473 0.5473
David Spielman 8 NA 11 NA NA NA 3 NA 7 8 0.5714 5 0.5211 0.2606
Shelly Bailey 9 10 NA 10 8 11 6 NA 13 7 0.5000 8 0.6271 0.5017
MICHAEL BRANSON 8 11 10 12 9 10 4 11 10 7 0.5000 10 0.6216 0.6216
PABLO BURGOSRAMOS 9 11 10 12 7 12 6 8 9 7 0.5000 10 0.6149 0.6149
Charlene Redmer 9 9 NA 9 9 11 NA 10 8 7 0.5000 8 0.5950 0.4760
Anthony Brinson 10 11 8 6 10 9 8 10 9 7 0.5000 10 0.5946 0.5946
Daniel Halse 8 9 10 NA NA NA 7 11 NA 7 0.5000 6 0.5843 0.3506
Patrick Tynan 8 8 10 11 7 NA 5 11 10 7 0.5000 9 0.5789 0.5210
THOMAS MCCOY 8 10 9 7 8 9 7 11 7 7 0.5000 10 0.5608 0.5608
Cherylynn Vidal 10 9 9 12 9 7 4 6 9 7 0.5000 10 0.5541 0.5541
Steven Curtis NA NA 11 7 8 10 6 7 8 7 0.5000 8 0.5517 0.4414
DERRICK ELAM 6 9 11 10 10 7 NA 5 7 7 0.5000 9 0.5333 0.4800
James Blejski 8 11 10 14 NA 9 7 12 7 6 0.4286 9 0.6269 0.5642
James Small 8 8 13 9 8 10 8 10 12 6 0.4286 10 0.6216 0.6216
Eric Hahn 9 13 7 9 8 10 6 9 10 6 0.4286 10 0.5878 0.5878
Kevin Green 9 12 9 9 8 9 7 NA NA 6 0.4286 8 0.5847 0.4678
Kristen White 7 13 8 11 6 7 7 10 8 6 0.4286 10 0.5608 0.5608
Daniel Kuehl 6 10 8 11 7 9 7 12 7 6 0.4286 10 0.5608 0.5608
Thomas Brenstuhl 10 NA 8 8 8 9 5 9 11 6 0.4286 9 0.5606 0.5045
Justin Thrift 9 8 9 8 9 7 5 11 7 6 0.4286 10 0.5338 0.5338
Trevor MACGAVIN 6 10 8 NA 6 7 4 NA 6 6 0.4286 8 0.4569 0.3655
Ryan Shipley 3 8 7 6 6 7 5 10 9 6 0.4286 10 0.4527 0.4527
Manuel Vargas 10 9 11 12 7 10 6 12 5 5 0.3571 10 0.5878 0.5878
Gregory Flint 6 11 NA 11 8 10 NA NA 9 5 0.3571 7 0.5714 0.4000
Khalil Ibrahim 7 12 9 NA 7 10 6 10 9 5 0.3571 9 0.5682 0.5114
Stephen Bush 7 10 10 9 7 10 6 12 NA 5 0.3571 9 0.5672 0.5105
Rafael Torres 6 8 12 11 NA NA 6 NA 9 5 0.3571 7 0.5534 0.3874
Min Choi 6 7 9 11 7 10 5 13 7 5 0.3571 10 0.5405 0.5405
Robert Martin 10 9 6 NA 9 9 6 9 NA 5 0.3571 8 0.5339 0.4271
Robert Lynch 9 9 6 10 10 6 4 9 10 5 0.3571 10 0.5270 0.5270
Melissa Printup 8 NA 8 7 10 7 6 NA NA 5 0.3571 7 0.5000 0.3500
Michael Edmunds 10 12 10 10 NA NA NA NA NA NA 0.0000 4 0.6774 0.2710
Stephen Woolwine 8 13 9 NA NA 9 NA 11 11 NA 0.0000 6 0.6703 0.4022
Antonio Mitchell 10 12 NA 11 10 10 5 12 9 NA 0.0000 8 0.6583 0.5266
Kevin O'NEILL 8 11 11 13 7 NA NA 10 NA NA 0.0000 6 0.6522 0.3913
Carlos Caceres 10 NA NA NA NA NA NA NA NA NA 0.0000 1 0.6250 0.0625
Donald Park 8 12 7 9 NA NA 6 10 11 NA 0.0000 7 0.6000 0.4200
Walter Archambo 7 10 10 11 7 9 5 9 12 NA 0.0000 9 0.5970 0.5373
Daniel Major 8 13 6 7 8 11 7 11 NA NA 0.0000 8 0.5917 0.4734
Pamela AUGUSTINE 11 13 6 9 6 9 5 10 9 NA 0.0000 9 0.5821 0.5239
Rahmatullah Sharifi 11 9 8 11 8 8 5 NA NA NA 0.0000 7 0.5769 0.4038
William Sherman 8 11 10 10 6 NA 5 NA 9 NA 0.0000 7 0.5728 0.4010
WAYNE SCHOFIELD 12 9 7 NA 8 NA 5 10 7 NA 0.0000 7 0.5631 0.3942
Jamal Willis 8 10 NA NA NA NA NA 9 NA NA 0.0000 3 0.5625 0.1687
Jason James 9 NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0562
Michael Beck 9 NA NA NA NA NA NA NA NA NA 0.0000 1 0.5625 0.0562
Derrick Zantt 11 6 7 NA 6 9 6 11 NA NA 0.0000 7 0.5385 0.3769
TYREE BUNDY 8 8 NA NA NA NA NA NA NA NA 0.0000 2 0.5000 0.1000
Edward Ford 6 8 NA NA NA NA NA NA NA NA 0.0000 2 0.4375 0.0875

Individual Plots

Season Leaderboard

Season Leaderboard (Season Percent)
Week 10
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Michael Edmunds 0 4 0.6774 0.2710
2 Stephen Woolwine 1 6 0.6703 0.4022
3 Justin Crick 0 10 0.6689 0.6689
4 George Sweet 1 9 0.6667 0.6000
4 Keithon Corpening 0 4 0.6667 0.2667
6 Sarah Sweet 0 9 0.6617 0.5955
7 William Schouviller 1 9 0.6593 0.5934
8 Antonio Mitchell 1 8 0.6583 0.5266
9 Kevin O'NEILL 0 6 0.6522 0.3913
10 Chris Papageorge 0 10 0.6486 0.6486
11 Ryan Wiggins 0 10 0.6351 0.6351
12 James Tierney 2 9 0.6343 0.5709
13 Vincent Scannelli 0 9 0.6316 0.5684
14 Jason Schattel 1 10 0.6284 0.6284
15 Shelly Bailey 1 8 0.6271 0.5017
16 Gabriel Quinones 0 9 0.6269 0.5642
16 James Blejski 1 9 0.6269 0.5642
18 Carlos Caceres 0 1 0.6250 0.0625
19 Anthony Bloss 1 10 0.6216 0.6216
19 Aubrey Conn 0 10 0.6216 0.6216
19 James Small 1 10 0.6216 0.6216
19 MICHAEL BRANSON 0 10 0.6216 0.6216
19 Ronald Schmidt 1 10 0.6216 0.6216
24 Montee Brown 0 8 0.6186 0.4949
24 Ramar Williams 0 8 0.6186 0.4949
26 PABLO BURGOSRAMOS 1 10 0.6149 0.6149
27 Bradley Hobson 0 9 0.6136 0.5522
27 Michael Moss 0 9 0.6136 0.5522
29 Brian Hollmann 2 10 0.6081 0.6081
29 Brian Patterson 0 10 0.6081 0.6081
29 Cheryl Brown 0 10 0.6081 0.6081
29 Ryan Cvik 0 10 0.6081 0.6081
29 Terry Hardison 0 10 0.6081 0.6081
34 Cody Koerwitz 0 9 0.6061 0.5455
34 George Mancini 0 9 0.6061 0.5455
36 Karen Coleman 2 9 0.6045 0.5440
37 Donald Park 0 7 0.6000 0.4200
38 Matthew Schultz 0 9 0.5985 0.5387
39 Walter Archambo 0 9 0.5970 0.5373
40 Charlene Redmer 0 8 0.5950 0.4760
41 Anthony Brinson 1 10 0.5946 0.5946
41 Bunnaro Sun 0 10 0.5946 0.5946
41 Kevin Kehoe 0 10 0.5946 0.5946
41 Paul Shim 0 10 0.5946 0.5946
41 Yiming Hu 0 10 0.5946 0.5946
46 Daniel Major 1 8 0.5917 0.4734
47 Paul Presti 0 9 0.5896 0.5306
48 John Plaster 0 8 0.5882 0.4706
49 Eric Hahn 1 10 0.5878 0.5878
49 Manuel Vargas 0 10 0.5878 0.5878
49 Shaun Dahl 1 10 0.5878 0.5878
52 Kevin Green 0 8 0.5847 0.4678
53 Daniel Halse 0 6 0.5843 0.3506
54 Pamela AUGUSTINE 1 9 0.5821 0.5239
55 Jonathon Leslein 0 10 0.5811 0.5811
55 Robert Gelo 0 10 0.5811 0.5811
57 Earl Dixon 0 9 0.5789 0.5210
57 Patrick Tynan 0 9 0.5789 0.5210
59 Rahmatullah Sharifi 0 7 0.5769 0.4038
60 DAVID PLATE 0 9 0.5758 0.5182
61 Daniel Baller 0 10 0.5743 0.5743
61 Shawn Carden 0 10 0.5743 0.5743
63 William Sherman 0 7 0.5728 0.4010
64 Gregory Flint 0 7 0.5714 0.4000
65 Khalil Ibrahim 0 9 0.5682 0.5114
66 Stephen Bush 0 9 0.5672 0.5105
67 WAYNE SCHOFIELD 1 7 0.5631 0.3942
68 Jamal Willis 0 3 0.5625 0.1687
68 Jason James 0 1 0.5625 0.0562
68 Michael Beck 0 1 0.5625 0.0562
71 Amy Asberry 0 10 0.5608 0.5608
71 Daniel Kuehl 0 10 0.5608 0.5608
71 Kristen White 1 10 0.5608 0.5608
71 THOMAS MCCOY 0 10 0.5608 0.5608
75 Thomas Brenstuhl 0 9 0.5606 0.5045
76 Brandon Parks 0 8 0.5593 0.4474
77 Cherylynn Vidal 0 10 0.5541 0.5541
78 Rafael Torres 0 7 0.5534 0.3874
79 Steven Curtis 0 8 0.5517 0.4414
80 Steven Webster 0 10 0.5473 0.5473
81 Alexander Santillan 0 9 0.5455 0.4910
82 Min Choi 1 10 0.5405 0.5405
83 Derrick Zantt 0 7 0.5385 0.3769
84 Robert Martin 0 8 0.5339 0.4271
85 Justin Thrift 0 10 0.5338 0.5338
86 DERRICK ELAM 1 9 0.5333 0.4800
87 Robert Lynch 1 10 0.5270 0.5270
88 David Spielman 0 5 0.5211 0.2606
89 Melissa Printup 1 7 0.5000 0.3500
89 TYREE BUNDY 0 2 0.5000 0.1000
91 Trevor MACGAVIN 0 8 0.4569 0.3655
92 Ryan Shipley 0 10 0.4527 0.4527
93 Edward Ford 0 2 0.4375 0.0875

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 10
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Justin Crick 0 10 0.6689 0.6689
2 Chris Papageorge 0 10 0.6486 0.6486
3 Ryan Wiggins 0 10 0.6351 0.6351
4 Jason Schattel 1 10 0.6284 0.6284
5 Anthony Bloss 1 10 0.6216 0.6216
5 Aubrey Conn 0 10 0.6216 0.6216
5 James Small 1 10 0.6216 0.6216
5 MICHAEL BRANSON 0 10 0.6216 0.6216
5 Ronald Schmidt 1 10 0.6216 0.6216
10 PABLO BURGOSRAMOS 1 10 0.6149 0.6149
11 Brian Hollmann 2 10 0.6081 0.6081
11 Brian Patterson 0 10 0.6081 0.6081
11 Cheryl Brown 0 10 0.6081 0.6081
11 Ryan Cvik 0 10 0.6081 0.6081
11 Terry Hardison 0 10 0.6081 0.6081
16 George Sweet 1 9 0.6667 0.6000
17 Sarah Sweet 0 9 0.6617 0.5955
18 Anthony Brinson 1 10 0.5946 0.5946
18 Bunnaro Sun 0 10 0.5946 0.5946
18 Kevin Kehoe 0 10 0.5946 0.5946
18 Paul Shim 0 10 0.5946 0.5946
18 Yiming Hu 0 10 0.5946 0.5946
23 William Schouviller 1 9 0.6593 0.5934
24 Eric Hahn 1 10 0.5878 0.5878
24 Manuel Vargas 0 10 0.5878 0.5878
24 Shaun Dahl 1 10 0.5878 0.5878
27 Jonathon Leslein 0 10 0.5811 0.5811
27 Robert Gelo 0 10 0.5811 0.5811
29 Daniel Baller 0 10 0.5743 0.5743
29 Shawn Carden 0 10 0.5743 0.5743
31 James Tierney 2 9 0.6343 0.5709
32 Vincent Scannelli 0 9 0.6316 0.5684
33 Gabriel Quinones 0 9 0.6269 0.5642
33 James Blejski 1 9 0.6269 0.5642
35 Amy Asberry 0 10 0.5608 0.5608
35 Daniel Kuehl 0 10 0.5608 0.5608
35 Kristen White 1 10 0.5608 0.5608
35 THOMAS MCCOY 0 10 0.5608 0.5608
39 Cherylynn Vidal 0 10 0.5541 0.5541
40 Bradley Hobson 0 9 0.6136 0.5522
40 Michael Moss 0 9 0.6136 0.5522
42 Steven Webster 0 10 0.5473 0.5473
43 Cody Koerwitz 0 9 0.6061 0.5455
43 George Mancini 0 9 0.6061 0.5455
45 Karen Coleman 2 9 0.6045 0.5440
46 Min Choi 1 10 0.5405 0.5405
47 Matthew Schultz 0 9 0.5985 0.5387
48 Walter Archambo 0 9 0.5970 0.5373
49 Justin Thrift 0 10 0.5338 0.5338
50 Paul Presti 0 9 0.5896 0.5306
51 Robert Lynch 1 10 0.5270 0.5270
52 Antonio Mitchell 1 8 0.6583 0.5266
53 Pamela AUGUSTINE 1 9 0.5821 0.5239
54 Earl Dixon 0 9 0.5789 0.5210
54 Patrick Tynan 0 9 0.5789 0.5210
56 DAVID PLATE 0 9 0.5758 0.5182
57 Khalil Ibrahim 0 9 0.5682 0.5114
58 Stephen Bush 0 9 0.5672 0.5105
59 Thomas Brenstuhl 0 9 0.5606 0.5045
60 Shelly Bailey 1 8 0.6271 0.5017
61 Montee Brown 0 8 0.6186 0.4949
61 Ramar Williams 0 8 0.6186 0.4949
63 Alexander Santillan 0 9 0.5455 0.4910
64 DERRICK ELAM 1 9 0.5333 0.4800
65 Charlene Redmer 0 8 0.5950 0.4760
66 Daniel Major 1 8 0.5917 0.4734
67 John Plaster 0 8 0.5882 0.4706
68 Kevin Green 0 8 0.5847 0.4678
69 Ryan Shipley 0 10 0.4527 0.4527
70 Brandon Parks 0 8 0.5593 0.4474
71 Steven Curtis 0 8 0.5517 0.4414
72 Robert Martin 0 8 0.5339 0.4271
73 Donald Park 0 7 0.6000 0.4200
74 Rahmatullah Sharifi 0 7 0.5769 0.4038
75 Stephen Woolwine 1 6 0.6703 0.4022
76 William Sherman 0 7 0.5728 0.4010
77 Gregory Flint 0 7 0.5714 0.4000
78 WAYNE SCHOFIELD 1 7 0.5631 0.3942
79 Kevin O'NEILL 0 6 0.6522 0.3913
80 Rafael Torres 0 7 0.5534 0.3874
81 Derrick Zantt 0 7 0.5385 0.3769
82 Trevor MACGAVIN 0 8 0.4569 0.3655
83 Daniel Halse 0 6 0.5843 0.3506
84 Melissa Printup 1 7 0.5000 0.3500
85 Michael Edmunds 0 4 0.6774 0.2710
86 Keithon Corpening 0 4 0.6667 0.2667
87 David Spielman 0 5 0.5211 0.2606
88 Jamal Willis 0 3 0.5625 0.1687
89 TYREE BUNDY 0 2 0.5000 0.1000
90 Edward Ford 0 2 0.4375 0.0875
91 Carlos Caceres 0 1 0.6250 0.0625
92 Jason James 0 1 0.5625 0.0562
92 Michael Beck 0 1 0.5625 0.0562

Data

---
title: "2023 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

```

```{r Reading in our picks files, include=FALSE}
current_week = 10 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2023 NFL Week 1.csv")
week_2 = read_csv("./CSV_Data_Files/2023 NFL Week 2.csv")
week_3 = read_csv("./CSV_Data_Files/2023 NFL Week 3.csv")
week_4 = read_csv("./CSV_Data_Files/2023 NFL Week 4.csv")
week_5 = read_csv("./CSV_Data_Files/2023 NFL Week 5.csv")
week_6 = read_csv("./CSV_Data_Files/2023 NFL Week 6.csv")
week_7 = read_csv("./CSV_Data_Files/2023 NFL Week 7.csv")
week_8 = read_csv("./CSV_Data_Files/2023 NFL Week 8.csv")
week_9 = read_csv("./CSV_Data_Files/2023 NFL Week 9.csv")
week_10 = read_csv("./CSV_Data_Files/2023 NFL Week 10.csv")
# week_11 = read_csv("./CSV_Data_Files/2023 NFL Week 11.csv")
# week_12 = read_csv("./CSV_Data_Files/2023 NFL Week 12.csv")
# week_13 = read_csv("./CSV_Data_Files/2023 NFL Week 13.csv")
# week_14 = read_csv("./CSV_Data_Files/2023 NFL Week 14.csv")
# week_15 = read_csv("./CSV_Data_Files/2023 NFL Week 15.csv")
# week_16 = read_csv("./CSV_Data_Files/2023 NFL Week 16.csv")
# week_17 = read_csv("./CSV_Data_Files/2023 NFL Week 17.csv")
# week_18 = read_csv("./CSV_Data_Files/2023 NFL Week 18.csv")
# week_19 = read_csv("./CSV_Data_Files/2023 NFL Wild Card.csv")
# week_20 = read_csv("./CSV_Data_Files/2023 NFL Divisional Round.csv")
# week_21 = read_csv("./CSV_Data_Files/2023 NFL Conference Round.csv")
# week_22 = read_csv("./CSV_Data_Files/2023 NFL Super Bowl.csv")

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2023 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10) #, week_11, week_12, week_13, week_14, week_15, week_16, week_17, week_18, week_19, week_20, week_21) #add in the additional weeks
# odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))

```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, echo=FALSE, out.width = "100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

### Individual Plots
```{r, out.width="100%"}
ggplotly(inst_indiv_plots)
```

### Season Leaderboard
```{r, out.width="100%"}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, out.width="100%"}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```